home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / HAM_RAD / PROPAGAT / 1004A.ZIP / METEOR.BAS < prev    next >
BASIC Source File  |  1987-05-12  |  20KB  |  453 lines
  1. 10 CLS: KEY OFF
  2. 20 PRINT:PRINT "           ***************** METEOR *******************": PRINT
  3. 30 PRINT "                 METEOR SCATTER PREDICTION PROGRAM
  4. 40 PRINT "                      MICHAEL R. OWEN, W9IP
  5. 50 PRINT "                          21 MAPLE ST.
  6. 60 PRINT "                       CANTON, NY  13617
  7. 70 PRINT
  8. 80  REM ***  THIS PROGRAM CALCULATES THE PEAK TIME FOR MAJOR METEOR
  9. 90  REM ***  SHOWERS.  IT ALSO PROVIDES INFORMATION CONCERNING THE
  10. 100 REM ***  OPTIMUM TIMES FOR PARTICULAR PATHS, IN GRAPHIC AND TABLE
  11. 110 REM ***  FORM.  THE PROGRAM IS WRITTEN FOR THE IBM-PC AND ALL
  12. 120 REM ***  COMPATIBLE COMPUTERS (MS-DOS OR PC-DOS, PLUS BASICA).
  13. 130 REM   ***********************************************************
  14. 140 REM   * PLEASE NOTE: YOU MUST ENTER YOUR OWN LATUTUDE AND       *
  15. 150 REM   * LONGITUDE ON LINES 190 AND 200 BELOW.  REMEMBER THAT    *
  16. 160 REM   * SOUTH LATITUDES AND WEST LONGITUDES ARE NEGATIVE.       *
  17. 170 REM   * YOU WILL ALSO WANT TO CHECK THE DEFAULT YEAR (LINE 3720)*
  18. 180 REM   ***********************************************************
  19. 190 MYLATD = 52.3: REM *** SOUTH LATITUDES ARE NEGATIVE!
  20. 200 MYLOND =- 3!:REM *** WEST LONGITUDES ARE NEGATIVE!
  21. 210 REM *** PC BASIC DOESN'T HAVE ARCCOS OR ARCSIN, SO DEFINE FUNCTIONS HERE
  22. 220 DEF FNACOS(X)=1.570796-ATN(X/SQR(1.000001-X*X))
  23. 230 DEF FNARSIN(X)= ATN(X/SQR(1!-X*X))
  24. 240 DIM LDATE(400),LTIME(400),LELEV(400),LAZIM(400)
  25. 250 REM *************************************
  26. 260 REM INITIALIZING PROGRAM: SETTING OPTIONS
  27. 270 REM *************************************
  28. 280 LENG=0: INCR=0: COUNTR=0: ENDER=1: BEST=0: HEADER=0: OPTDIR=0: BESEL=90
  29. 290 GOSUB 4400
  30. 300 IF COUNTR=1 THEN  CLS
  31. 310 PRINT: PRINT: PRINT
  32. 320 PRINT "                         OPTIONS:"
  33. 330 PRINT
  34. 340 PRINT "       1)  PEAK TIME PREDICTION"
  35. 350 PRINT "       2)  (1) PLUS GRAPH OF AZ/EL OF RADIANT FOR A PARTICULAR PATH"
  36. 360 PRINT "       3)  LISTING OF GOOD TIMES FOR ALL PATHS"
  37. 370 PRINT "       4)  BEST PATH FOR A PARTICULAR TIME"
  38. 380 PRINT
  39. 390 PRINT
  40. 400 INPUT "WHAT IS YOUR CHOICE (1-4)";WHICH
  41. 410 IF WHICH <1 OR WHICH>5 THEN 400
  42. 420 IF WHICH <>2 THEN 550
  43. 430 CLS: PRINT "WHICH GENERAL DIRECTION?"
  44. 440 PRINT: PRINT
  45. 450 PRINT "1) NORTH": PRINT "2) NORTHEAST": PRINT "3) EAST"
  46. 460 PRINT "4) SOUTHEAST": PRINT "5) SOUTH": PRINT "6) SOUTHWEST"
  47. 470 PRINT "7) WEST": PRINT "8) NORTHWEST"
  48. 480 PRINT: PRINT "9) SPECIFIC LAT,LON          (SOUTH LAT AND WEST LON ARE NEGATIVE)"
  49. 490 PRINT: PRINT "10) SPECIFIC BEARING FROM YOUR QTH (0-360)"
  50. 500 PRINT: PRINT: PRINT: INPUT "CHOOSE DIRECTION BY NUMBER (1-10)";DIRECTION
  51. 510 IF DIRECTION <1 OR DIRECTION >10 THEN 500
  52. 520 IF WHICH <>2 THEN 550
  53. 530 IF DIRECTION=9 THEN INPUT "OTHER STATION'S LAT,LONG ";HISLATD,HISLOND: GOSUB 3270
  54. 540 IF DIRECTION=10 THEN INPUT "BEARING (DEGREES)";LOOK
  55. 550 CLS: PRINT: PRINT: PRINT  "      METEOR SHOWER" TAB(27);"DATE"
  56. 560 PRINT
  57. 570 PRINT "    1)  QUADRANTIDS ";TAB(25);" 4 JANUARY"
  58. 580 PRINT "    2)  LYRIDS      ";TAB(25);"22 APRIL"
  59. 590 PRINT "    3)  ETA AQUARIDS";TAB(25);" 4 MAY"
  60. 600 PRINT "    4)  ARIETIDS    ";TAB(25);" 7 JUNE"
  61. 610 PRINT "    5)  PERSEIDS    ";TAB(25);"12 AUGUST"
  62. 620 PRINT "    6)  DRACONIDS   ";TAB(25);"10 OCTOBER"
  63. 630 PRINT "    7)  ORIONIDS    ";TAB(25);"20 OCTOBER"
  64. 640 PRINT "    8)  LEONIDS     ";TAB(25);"17 NOVEMBER"
  65. 650 PRINT "    9)  GEMINIDS    ";TAB(25);"13 DECEMBER"
  66. 660 PRINT: PRINT: PRINT
  67. 670 INPUT "FOR WHICH SHOWER DO YOU WANT INFORMATION (1-9)";SHOWER
  68. 680 IF SHOWER <1 OR SHOWER >9 THEN 670
  69. 690 GOSUB 3670: IF WHICH=1 THEN 2400
  70. 700 IF WHICH=4 THEN PRINT:PRINT: INPUT "WHAT TIME (OPT. 4)";STARTTIME: GOTO 780
  71. 710 PRINT: PRINT "FOR THIS RUN,                       DEFAULT VALUES IN [ ]"
  72. 720 PRINT: INPUT "HOW LONG? (HOURS)  [24]  "; LENG
  73. 730 IF LENG=0 THEN LENG=24: REM *** DEFAULT ON EMPTY RETURN
  74. 740 LENG=LENG*100
  75. 750 INPUT "WHAT INCREMENT (MINUTES)  [60]  "; INCR
  76. 760 IF INCR=0 THEN INCR=60: REM *** DEFAULT ON EMPTY RETURN
  77. 770 IF INCR>60 THEN INCR=CINT((INCR/60)*100)
  78. 780 PRINT "DO YOU WANT INFORMATION FOR THE PEAK DAY ("M"/"DAY")?   [Y]  ":INPUT CENT$
  79. 790 IF CENT$<>"N" THEN CENT$="Y": REM *** DEFAULT ON EMPTY RETURN
  80. 800 IF CENT$="Y" THEN 820
  81. 810 INPUT "WHAT DATE DO YOU WANT (MONTH, DAY)"; M,DAY
  82. 820 IF WHICH=4 THEN 870
  83. 830 INPUT "START TIME, UTC (EXAMPLE: 0000)   [0000]  "; STARTTIME
  84. 840 REM *** STARTTIME=0 IS AUTOMATIC
  85. 850 REM *** THIS LOOP "LOOKS" AROUND THE COMPASS AT 45 DEGREE INCREMENTS
  86. 860 IF WHICH=3 THEN FOR DIRECTION = 1 TO 8
  87. 870 ROUNDS=0
  88. 880 TIME=STARTTIME
  89. 890 TIMECOUNT=TIME
  90. 900 FINISH=TIMECOUNT+LENG+100
  91. 910 GOSUB 2490: T=S*15*R1
  92. 920 IF COUNTR>0 THEN 1070
  93. 930 REM *** INPUT RIGHT ASCENSION DATA: RAHOUR, RAMIN IN DATA STATEMENT.
  94. 940 REM *** A$ IS HOURS, A2 IS MIN, A3 IS SEC.
  95. 950 REM *** CHANGE THESE OR WRITE AN INPUT STATEMENT IF YOU WANT TO
  96. 960 REM *** EVALUATE OTHER METEOR SHOWERS (OR OTHER CELESTIAL OBJECTS)
  97. 970 A$= STR$(RAHOUR): A2=RAMIN: A3=0
  98. 980 GOSUB 2420: R=A*15*R1
  99. 990 REM *** INPUT DECLINATION, SAME COMMENTS AS ABOVE
  100. 1000 A$=STR$(DEC): A2=0: A3=0
  101. 1010 GOSUB 2420: DEG=A*R1
  102. 1020 IF WHICH<>4 THEN 1070
  103. 1030 PRINT: PRINT: PRINT "PLEASE WAIT"
  104. 1040 FOR BESTDIR=0 TO 355 STEP 5
  105. 1050 ANGLE=BESTDIR
  106. 1060 GOTO 1210
  107. 1070 IF WHICH=2 AND COUNTR=1 THEN 1240
  108. 1080 REM *** THIS SECTION CHOOSES PATHS IN 45 DEGREE STEPS
  109. 1090 IF DIRECTION = 9 THEN GOSUB 3270: GOSUB 2810: GOTO 1270
  110. 1100 IF DIRECTION = 1 THEN ANGLE=0:WAY$="N"
  111. 1110 IF DIRECTION = 2 THEN ANGLE=45: WAY$="NE"
  112. 1120 IF DIRECTION = 3 THEN ANGLE=90: WAY$="E"
  113. 1130 IF DIRECTION = 4 THEN ANGLE=135: WAY$="SE"
  114. 1140 IF DIRECTION = 5 THEN ANGLE=180: WAY$="S"
  115. 1150 IF DIRECTION = 6 THEN ANGLE=225: WAY$="SW"
  116. 1160 IF DIRECTION = 7 THEN ANGLE=270: WAY$="W"
  117. 1170 IF DIRECTION = 8 THEN ANGLE=315: WAY$="NW"
  118. 1180 IF DIRECTION = 10 THEN ANGLE=LOOK
  119. 1190 REM *** "RIGHT" AND "RIGHT2" ARE THE AZIMUTH OF POINTS AT
  120. 1200 REM ***  90 DEGREE ANGLES TO THE PATH OF INTEREST.
  121. 1210 RIGHT=(ANGLE+90) MOD 360: RIGHT2=(ANGLE+270) MOD 360
  122. 1220 IF WHICH=3 OR COUNTR=0 THEN IF ROUNDS=0 THEN GOSUB 4270
  123. 1230 IF ROUNDS=0 THEN MIDLATD=CIRLATD: MIDLOND=CIRLOND
  124. 1240 IF WHICH=2 AND COUNTR=0 THEN GOSUB 2810: REM SET UP GRAPH
  125. 1250 REM *** MIDLATD AND MIDLOND ARE THE SPOTS HALFWAY ALONG THE
  126. 1260 REM *** PATH OF INTEREST (THIS IS WHERE THE METEORS NEED TO BE).
  127. 1270 B=MIDLATD: L=MIDLOND
  128. 1280 B=B*R1: L=L*R1
  129. 1290 REM *** THIS SECTION DETERMINES THE AZ AND EL OF THE RADIANT BASED
  130. 1300 REM *** ON ITS R.A. AND DEC. AT PATH MIDPOINT.
  131. 1310 T5=T-R+L: REM LHA
  132. 1320 COSDEG=COS(DEG): SINDEG=SIN(DEG)
  133. 1330 SINB=SIN(B)
  134. 1340 S1=SINB*SINDEG
  135. 1350 COSINB=COS(B)
  136. 1360 S1=S1+COSINB*COSDEG*COS(T5)
  137. 1370 C1=1-S1*S1
  138. 1380 IF C1>0 THEN C1=SQR(C1)
  139. 1390 IF C1<=0 THEN 1410
  140. 1400 H=ATN(S1/C1): GOTO 1420
  141. 1410 H=SGN(S1)*P/2
  142. 1420 C2=(COSINB*SINDEG)-SINB*COSDEG*COS(T5)
  143. 1430 S2=-COSDEG*SIN(T5)
  144. 1440 IF C2=0 THEN A=SGN(S2)*P/2:GOTO 1470
  145. 1450 A=ATN(S2/C2)
  146. 1460 IF C2<0 THEN A=A+P
  147. 1470 IF A <0 THEN A=A+2*P
  148. 1480 ELEV=H/R1: AZIM=A/R1
  149. 1490 REM *** LOAD ARRAY WITH AZ, EL DATA
  150. 1500 IF WHICH<>2 THEN 1550
  151. 1510 LAZIM(ENDER)=AZIM
  152. 1520 LELEV(ENDER)=ELEV
  153. 1530 LDATE(ENDER)=DAY
  154. 1540 LTIME(ENDER)=TIME
  155. 1550 IF ELEV<0 THEN 1840
  156. 1560 QUAL=0: BEST=0
  157. 1570 REM *** ROUTINE TO INDICATE THE TIMES WHEN THE RADIANT IS
  158. 1580 REM *** WITHIN +/- 15 DEG OF PERPENDICULAR TO THE DESIRED
  159. 1590 REM *** PATH (GOOD) AND WHEN IT IS ALSO WITHIN +/- 15 DEG OF
  160. 1600 REM *** 45 DEG ELEVATION AT PATH MIDPOINT (BEST).
  161. 1605 IF ELEV<20 AND WHICH=4 THEN 1660
  162. 1610 IF ELEV<20 THEN 1740
  163. 1620 IF (AZIM>(RIGHT-15) AND AZIM<(RIGHT+15)) OR (AZIM>(RIGHT2-15) AND AZIM<(RIGHT2+15)) THEN QUAL=1
  164. 1630 IF QUAL=1 AND ELEV>30 AND ELEV<60 THEN BEST=1
  165. 1640 IF WHICH<>4 THEN 1740
  166. 1650 IF BEST=1 AND ABS(45-ELEV)<ABS(45-BESTEL) THEN OPTDIR=ANGLE: BESTEL=ELEV
  167. 1660 NEXT BESTDIR
  168. 1670 BEEP: COLOR 15
  169. 1680 IF OPTDIR>1 THEN 1720
  170. 1690 PRINT: PRINT "NO GOOD DIRECTIONS AT";TIME;"UTC."
  171. 1700 PRINT: PRINT "RUN OPTION 2 TO CHECK IF RADIANT IS ABOVE HORIZON"
  172. 1710 PRINT: PRINT: COLOR 7: GOTO 2200
  173. 1720 PRINT:PRINT "BEST DIRECTION AT";TIME; "UTC ="OPTDIR;"DEGREES"
  174. 1730 COLOR 7: GOTO 2200
  175. 1740 IF WHICH=3 THEN 1790
  176. 1750 IF QUAL=1 AND BEST=0 THEN LOCATE 23,10:PRINT "GOOD TIME:" TIME
  177. 1760 COLOR 15
  178. 1770 IF BEST=1 AND ABS(45-ELEV)<ABS(45-BESEL) THEN BESEL=ELEV:BESTIME=TIME
  179. 1780 COLOR 7
  180. 1790 IF WHICH=3 AND HEADER=0 THEN GOSUB 2990
  181. 1800 IF QUAL=1 AND BEST=0 AND WHICH=3 THEN PRINT TIME,WAY$
  182. 1810 COLOR 15
  183. 1820 IF BEST=1 AND WHICH=3 THEN  PRINT TAB(30) TIME,WAY$
  184. 1830 COLOR 7
  185. 1840 IF WHICH <>2 THEN 2020
  186. 1850 IF COUNTR<>0 THEN 1920
  187. 1860 LOCATE 21,5
  188. 1870 PRINT"NORTH                        SOUTH                        NORTH"
  189. 1880 REM *** PLOT THE APPROXIMATE AZ, EL DATA FOR
  190. 1890 REM *** THE RADIANT AS A FUNCTION OF TIME.
  191. 1900 REM *** THE 'LOCATE' ARGUMENT IS DERIVED FROM
  192. 1910 REM *** INTEGER VALUES OF AZ AND EL.
  193. 1920 J=CINT(AZIM/6)+5
  194. 1930 I=CINT(20-(ELEV/5))
  195. 1940 IF I<=0 THEN I=1
  196. 1950 IF I>20 THEN I=20
  197. 1960 PNT$=STR$(INT(TIME/100))
  198. 1970 IF I=20 THEN 2020
  199. 1980 REM *** HIGHLIGHT BEST TIMES ON THE GRAPH
  200. 1990 IF BEST=1 THEN COLOR 15
  201. 2000 LOCATE I,J: PRINT "*";PNT$
  202. 2010 COLOR 7
  203. 2020 TIMECOUNT=TIMECOUNT+INCR
  204. 2030 IF TIMECOUNT-(INT(TIMECOUNT/100)*100)=>60 THEN TIMECOUNT=TIMECOUNT+40
  205. 2040 TIME=TIME+INCR
  206. 2050 COUNTR=1: ENDER=ENDER+1
  207. 2060 ROUNDS=1
  208. 2070 IF TIMECOUNT<FINISH THEN 910
  209. 2080 IF WHICH=2 AND DIRECTION < 9 THEN LOCATE 23,55: PRINT WAY$;" PATH"
  210. 2090 IF WHICH=2 AND DIRECTION>8 THEN LOCATE 23,55:PRINT "BEARING:";CINT(ANGLE);"DEG."
  211. 2100 IF WHICH=3 THEN NEXT DIRECTION: BEEP: GOTO 2200
  212. 2110 IF BESTIME=0 THEN 2130
  213. 2120 LOCATE 23,30: PRINT "BEST TIME:"BESTIME
  214. 2130 LOCATE 24,10
  215. 2140 IF WHICH=2 THEN INPUT "DO YOU WANT LISTED OUTPUT"; LISTED$
  216. 2150 IF LISTED$="Y" THEN PRINT: PRINT "                SHOWER: ";SHOWER$: PRINT
  217. 2160 IF LISTED$="Y" THEN PRINT"DAY","TIME, UTC","AZIMUTH","ELEVATION" ELSE 2200
  218. 2170 FOR K=1 TO ENDER-1
  219. 2180 PRINT LDATE(K),LTIME(K),LAZIM(K),LELEV(K)
  220. 2190 NEXT K
  221. 2200 INPUT "DO YOU WANT ANOTHER RUN (Y/N)"; AGAIN$
  222. 2210 IF AGAIN$="Y" THEN COUNTR=0: ENDER=0: PRINTED=0: BESTEL=999
  223. 2220 IF AGAIN$="Y" THEN 280 ELSE 2400
  224. 2230 REM **************************************************
  225. 2240 REM   DATA FOR MAJOR (AND SOME MINOR) METEOR SHOWERS
  226. 2250 REM   FROM "ASTRONOMICAL CALENDAR 1985" BY GUY OTTWELL,
  227. 2260 REM   PHYSICS DEPT, FURMAN UNIV.,GREENVILLE, SC.
  228. 2270 REM **************************************************
  229. 2280 REM *** DATA FORMAT: NAME, E.L., MONTH, DAY, TIME ABOVE QUARTER MAX,
  230. 2290 REM *** VELOCITY (KM/SEC), APPROX. RATE, RADIANT R.A. HOURS, R.A. MINUTES,
  231. 2300 REM *** DECLINATION, CEPLECHA'S CLASS, HEIGHT OF IONIZATION (KM)
  232. 2310 DATA QUADRANTIDS,282.80,1,4,14 HOURS,41.5,110,15,28,50,B,100
  233. 2320 DATA LYRIDS,31.4,4,21,2.3 DAYS,47,VARIABLE,18,8,32,BC,105
  234. 2330 DATA ETA AQUARIDS,44,5,4,3 DAYS,67,21,22,20,-1,C2,115
  235. 2340 DATA ARIETIDS,75.0,6,5,RICH BUT SMALL,37,60,2,56,23,UNKNOWN,100
  236. 2350 DATA PERSEIDS,139.3,8,11,4.6 DAYS,60,68,3,4,58,C2,110
  237. 2360 DATA DRACONIDS, 196.3,10,10,1.2 HOURS,21,42,17,28,54,C1,97
  238. 2370 DATA ORIONIDS, 207,10,20,2 DAYS,67,35,6,20,15,C2,115
  239. 2380 DATA LEONIDS, 234.7,11,16,4 DAYS,71,40,10,8,22,C2,150
  240. 2390 DATA GEMINIDS, 261.9,12,13,2.6 DAYS,35,58,7,28,32,B,95
  241. 2400 KEY ON: END
  242. 2410 REM *********************************
  243. 2420 REM SEXAGESIMAL TO DECIMAL CONVERSION
  244. 2430 REM *********************************
  245. 2440 S=1: A1=ABS(VAL(A$))
  246. 2450 IF LEFT$(A$,1)="-" THEN S=-1
  247. 2460 A=S*(A1+A2/60+A3/3600)
  248. 2470 RETURN
  249. 2480 REM ***************************************
  250. 2490 REM GREENWICH MEAN SIDERIAL TIME CONVERSION
  251. 2500 REM ***************************************
  252. 2510 HOUR=INT(TIME/100)
  253. 2520 MIN=TIME-(HOUR*100)
  254. 2530 IF MIN=>60 THEN TIME=TIME+40: GOTO 2510
  255. 2540 IF TIME>2400 THEN TIME=TIME-2400: DAY=DAY+1
  256. 2550 HOUR=HOUR/24: MIN=MIN/1440
  257. 2560 D=DAY+HOUR+MIN
  258. 2570 D1=INT(D): F=D-D1-.5
  259. 2580 J=-INT(7*(INT((M+9)/12)+Y)/4)
  260. 2590 S=SGN(M-9): A=ABS(M-9)
  261. 2600 J1=INT(Y+S*INT(A/7))
  262. 2610 J1=-INT((INT(J1/100)+1)*3/4)
  263. 2620 J=J+INT(275*M/9)+D1+J1
  264. 2630 J=J+1721027!+2+367*Y
  265. 2640 IF F>=0 THEN 2670
  266. 2650 F=F+1: J=J-1
  267. 2660 D=J-2451545!
  268. 2670 T=D/36525!: T1=INT(T)
  269. 2680 J0=T1*36525!+2451545!
  270. 2690 T2=(J-J0+.5)/36525!
  271. 2700 S=24110.54841#+184.812866#*T1
  272. 2710 S=S+8640184.812866#*T2
  273. 2720 S=S+.093104*T*T
  274. 2730 S=S-.0000062*T*T*T
  275. 2740 S=S/86400!: S=S-INT(S)
  276. 2750 S=24*(S+(F-.5)*1.002737909#)
  277. 2760 IF S<0 THEN S=S+24
  278. 2770 IF S>24 THEN S=S-24
  279. 2780 RETURN
  280. 2790 REM *******************************
  281. 2800 REM ROUTINE TO INITIALIZE THE GRAPH
  282. 2810 REM *******************************
  283. 2820 CLS
  284. 2830 LOCATE 1,22: PRINT "SHOWER: ";SHOWER$; "(";M;"/"DAY;"/"Y;")"
  285. 2840 LOCATE 2,13
  286. 2850 PRINT "AZ, EL OF RADIANT AT PATH MIDPOINT: LAT";CINT(MIDLATD);"LON ";CINT(MIDLOND)
  287. 2860 FOR I=2 TO 20
  288. 2870 LOCATE I,3:PRINT (90-(I*5))+10
  289. 2880 NEXT I
  290. 2890 LOCATE 5,1: PRINT "E": LOCATE 6,1: PRINT "L": LOCATE 7,1: PRINT "E"
  291. 2900 LOCATE 8,1: PRINT "V": LOCATE 9,1: PRINT "A": LOCATE 10,1: PRINT "T"
  292. 2910 LOCATE 11,1: PRINT "I": LOCATE 12,1: PRINT "O": LOCATE 13,1: PRINT "N"
  293. 2920 REM SET BOTTOM AXIS
  294. 2930 FOR J=5 TO 65 STEP 5
  295. 2940 LOCATE 20,J-1:PRINT (J-5)*6
  296. 2950 NEXT J
  297. 2960 LOCATE 11,7: PRINT "-------------------------------------------------------------"
  298. 2970 RETURN
  299. 2980 REM *************************
  300. 2990 REM ROUTINE TO TITLE OPTION 3
  301. 3000 REM A************************
  302. 3010 CLS: PRINT "SHOWER: ";SHOWER$ "   DATE: "M;"/"DAY;"/"Y; "  PEAK AT ";GMT;" UTC": PRINT:
  303. 3020 PRINT "    GOOD TIMES"
  304. 3030 COLOR 15
  305. 3040 LOCATE 3,33: PRINT "BEST TIMES"
  306. 3050 COLOR 7
  307. 3060 HEADER=1
  308. 3070 RETURN
  309. 3080 REM *********************************************
  310. 3090 REM ROUTINE TO CALCULATE ECLIPTIC LONGITUDE FROM
  311. 3100 REM 'THE ASTRONOMICAL ALMANAC FOR 1985' PAGE C24.
  312. 3110 REM *********************************************
  313. 3120 JC#=CDBL(J)
  314. 3130 FC#=CDBL(F)
  315. 3140 JD#=JC#+FC#
  316. 3150 REM *** JD# IS DOUBLE-PRECISION JULIAN DAY
  317. 3160 N#=JD#-2451545#
  318. 3170 LONSUN#=280.46+(.9856474*N#)
  319. 3180 G#=357.528+(.9856003*N#)
  320. 3190 IF LONSUN#<0 THEN LONSUN#=LONSUN#+360!
  321. 3200 IF G#<0 THEN G#=G#+360!
  322. 3210 IF LONSUN#<0 THEN 3190
  323. 3220 IF G#<0 THEN 3200
  324. 3230 RCON#=180!/3.141592654#
  325. 3240 LONSUNT#=LONSUN#+(1.915*SIN(G#/RCON#))+(.02*SIN(2*(G#/RCON#)))
  326. 3250 RETURN
  327. 3260 REM *********************************************
  328. 3270 REM ROUTINE TO DETERMINE THE BEARING AND DISTANCE
  329. 3280 REM BETWEEN ANY TWO POINTS ON THE EARTH.
  330. 3290 REM *********************************************
  331. 3300 IF DIRECTION<>9 THEN HISLATD=CIRLATD: HISLOND=CIRLOND
  332. 3310 DIFLOND=MYLOND-HISLOND
  333. 3320 MIDLATD=MYLATD-((MYLATD-HISLATD)/2)
  334. 3330 REM *** DIFFERENCE IN LONGITUDES MUST FALL BETWEEN -180 AND +180
  335. 3340 IF DIFLOND<-180 THEN DIFLOND=DIFLOND+360
  336. 3350 IF DIFLOND>180 THEN DIFLOND=DIFLOND-360
  337. 3360 REM *** DEGREES TO RADIANS CONVERSION
  338. 3370 HISLAT=HISLATD*R1: HISLON=HISLOND*R1
  339. 3380 DIFLON=DIFLOND*R1
  340. 3390 REM *** DISTANCE CALCULATION
  341. 3400 COSB=(SMYLAT*SIN(HISLAT))+(CMYLAT*COS(HISLAT)*COS(DIFLON))
  342. 3410 BETA=FNACOS(COSB)
  343. 3420 BETA2=BETA/R1
  344. 3430 REM *** '69.05' IS THE CONVERSION FACTOR FOR STATUTE MILES.
  345. 3440 REM *** FOR KILOMETERS, USE 111.2, AND FOR NAUTICAL MILES 60.0.
  346. 3450 DIST=BETA2*69.05
  347. 3460 REM *** BEARING CALCULATION
  348. 3470 COSA=(SIN(HISLAT)-(SMYLAT*COSB))/(CMYLAT*SIN(BETA))
  349. 3480 REM *** ROUNDING ERRORS SOMETIMES LET COSA>1 OR <-1 (ERROR)
  350. 3490 IF COSA>1! THEN COSA=1!
  351. 3500 IF COSA<-1! THEN COSA=-1!
  352. 3510 AZ=FNACOS(COSA)
  353. 3520 ANGLE=AZ/R1
  354. 3530 REM *** HAFLON IS THE LON OF A POINT BETWEEN HERE AND THERE
  355. 3540 HAFLON=FNACOS((COS(BETA/2)-(SMYLAT*SIN(MIDLATD*R1)))/(CMYLAT*COS(MIDLATD*R1)))
  356. 3550 IF DIFLOND>0 THEN ANGLE=360!-ANGLE
  357. 3560 IF DIRECTION<>9 OR PRINTED=1 OR WHICH<>2 THEN 3600
  358. 3570 PRINT: PRINT "DISTANCE: ";DIST;" MILES," BETA2*111.2;" KM";"   BEARING:";ANGLE;" DEGREES"
  359. 3580 INPUT "PRESS 'ENTER' TO CONTINUE" ;PAUSE$
  360. 3590 PRINTED=1
  361. 3600 IF ANGLE>180 THEN HAFLON=MYLON-HAFLON ELSE HAFLON=MYLON+HAFLON
  362. 3610 MIDLOND=HAFLON/R1
  363. 3620 RETURN
  364. 3630 REM ************************************************************
  365. 3640 REM ROUTINE TO READ DATA AND CALCULATE PEAK DATE/TIME MODIFIED
  366. 3650 REM AFTER PROGRAMS BY RUSS WICKER (W4WD) AND JOE REISERT (W1JR).
  367. 3660 REM ************************************************************
  368. 3670 FOR I=1 TO SHOWER
  369. 3680 READ SHOWER$,ELON,M,DAY,DURATION$,VELOCITY$,RATE$,RAHOUR,RAMIN,DEC,CLASS$,HEIGHT
  370. 3690 NEXT I
  371. 3700 RESTORE
  372. 3710 PRINT: PRINT: INPUT "        WHAT YEAR     [1986]  "; Y
  373. 3720 IF Y=0 THEN Y=1986
  374. 3730 TIME=0
  375. 3740 GOSUB 2490
  376. 3750 GOSUB 3090
  377. 3760 IF LONSUNT#>ELON THEN 3810
  378. 3770 DAY=DAY+1
  379. 3780 GOSUB 2490
  380. 3790 GOSUB 3090
  381. 3800 GOTO 3760
  382. 3810 IF LONSUNT#<=ELON THEN 3860
  383. 3820 E2=LONSUNT#
  384. 3830 DAY=DAY-1
  385. 3840 GOSUB 2490
  386. 3850 GOSUB 3090
  387. 3860 T=24*((ELON-LONSUNT#)/(E2-LONSUNT#))
  388. 3870 H0=INT(T)
  389. 3880 M1=INT(60*(T-H0)+.5)
  390. 3890 GMT=100*H0+M1
  391. 3900 IF GMT<0 THEN DAY=DAY-1: GOTO 3740
  392. 3910 IF DAY<=31 THEN 3940
  393. 3920 DAY=DAY-31
  394. 3930 M=M+1
  395. 3940 CLS: PRINT: PRINT
  396. 3950 PRINT "THE ";SHOWER$;" METEOR SHOWER WILL PEAK ON";M;"/";DAY;"/";Y
  397. 3960 PRINT "AT";GMT;"UTC."
  398. 3970 IF WHICH>1 THEN 700
  399. 3980 PRINT: PRINT: INPUT "MORE INFO ON THIS SHOWER    [Y]  ";MOREINFO$
  400. 3990 IF MOREINFO$<>"N" THEN MOREINFO$="Y"
  401. 4000 IF MOREINFO$<>"Y" THEN 4190
  402. 4010 PRINT
  403. 4020 PRINT "     SHOWER: ";SHOWER$
  404. 4030 PRINT: PRINT "DURATION ABOVE QUARTER MAX.: ";DURATION$
  405. 4040 PRINT "VELOCITY: ";VELOCITY$;" KM/SEC"
  406. 4050 PRINT "AVERAGE HEIGHT OF IONIZATION: "; HEIGHT;" KM"
  407. 4060 PRINT "METEORS PER HOUR (APPROX): " RATE$
  408. 4070 PRINT "E.L. USED FOR CALCULATION: ";ELON;" DEGREES  (EPOCH 2000.0)"
  409. 4080 PRINT "R.A. OF RADIANT: ";RAHOUR;" HR ";RAMIN;" MIN"
  410. 4090 PRINT "DECLINATION:"; DEC "DEGREES"
  411. 4100 PRINT "CEPLECHA'S CLASS: ";CLASS$
  412. 4110 TIME=GMT: GOSUB 2490: GOSUB 3090: ROUNDLON=INT(LONSUNT#*1000)/1000
  413. 4120 PRINT: PRINT "E.L. AT"GMT"=";ROUNDLON
  414. 4130 TIME=0: GOSUB 2490: GOSUB 3090: ROUNDLON=INT(LONSUNT#*1000)/1000
  415. 4140 DEGLON=INT(LONSUNT#): MINLON=INT((LONSUNT#-DEGLON)*60)
  416. 4150 SECLON=(INT((((LONSUNT#-DEGLON)*60)-MINLON)*60)*100)/100
  417. 4160 REM *** NEXT LINE IS DISPLAYED SO YOU CAN CHECK THE CALCULATED
  418. 4170 REM *** E.L. AGAINST THE NAUTICAL ALMANAC.
  419. 4180 PRINT "E.L. AT 0000 =";ROUNDLON,"(=";DEGLON;"DEGREES";MINLON;"MINUTES";SECLON "SECONDS)"
  420. 4190 PRINT: INPUT "DO YOU WANT ANOTHER RUN (Y/N)     [Y]   ";ANOTHER$
  421. 4200 IF ANOTHER$<>"N" THEN ANOTHER$="Y"
  422. 4210 IF ANOTHER$="Y" THEN 300 ELSE 2400
  423. 4220 RETURN
  424. 4230 REM ****************************************************
  425. 4240 REM *** ROUTINE TO CALCULATE LAT, LON OF A 500-MI CIRCLE
  426. 4250 REM *** WHICH REPRESENTS THE 1000-MILE PATH MIDPOINT
  427. 4260 REM ****************************************************
  428. 4270 COSA2=COS(ANGLE*R1): REM *** ANGLE IS THE BEARING FROM YOUR QTH
  429. 4280 REM *** CIRLATD IS THE LATITUDE OF THE POINT
  430. 4290 CIRLAT=FNARSIN ((COSA2*CMYLAT*SINBETA2)+(SMYLAT*COSBETA2))
  431. 4300 CIRLATD=CIRLAT/R1
  432. 4310 REM *** CIRLOND IS THE LONGITUDE OF THE POINT
  433. 4320 CIRLON= (COSBETA2-(SMYLAT*SIN(CIRLAT)))/(CMYLAT*COS(CIRLAT))
  434. 4330 IF CIRLON>1 THEN CIRLON=1!
  435. 4340 IF CIRLON<-1 THEN CIRLON=-1!
  436. 4350 CIRLON=FNACOS(CIRLON)
  437. 4360 IF ANGLE>180 THEN CIRLON=MYLON-CIRLON ELSE CIRLON=MYLON+CIRLON
  438. 4370 CIRLOND=CIRLON/R1
  439. 4380 RETURN
  440. 4390 REM *********************************************
  441. 4400 REM *** ROUTINE TO INITIALIZE VARIABLES WHICH ARE
  442. 4410 REM *** USED OFTEN.  THIS SPEEDS THINGS UP.
  443. 4420 REM *********************************************
  444. 4430 P=3.141593: R1=P/180!
  445. 4440 MYLON=MYLOND*R1: MYLAT=MYLATD*R1
  446. 4450 CMYLAT=COS(MYLAT): SMYLAT=SIN(MYLAT)
  447. 4460 REM *** CIRRANGE=500 IS THE DISTANCE TO PATH MIDPOINT; THIS
  448. 4470 REM *** REPRESENTS A 1000-MILE RANGE; CHANGE FOR ANOTHER DISTANCE.
  449. 4480 CIRRANGE=500:CIRBETA2=(CIRRANGE/69.05)*R1:REM FOR KM CHANGE 69.05 TO 111.2
  450. 4490 COSBETA2=COS(CIRBETA2): SINBETA2=SIN(CIRBETA2)
  451. 4500 RETURN
  452. 4510 END
  453.